00100	COMMENT ⊗   VALID 00015 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00003 00002	TITLE CREIO - CRE INPUT OUTPUT SUBROUTINES - BGB - 16 APRIL 1973.
00500	C00006 00003	SUBR(FILNUM)SERIAL.	SETUP FILE-SERIAL-NUMBER-NAME.
00600	C00008 00004	SUBR(TVDSKI)SERIAL		INPUT TV PICTURE FROM DISK FILE.
00700	C00010 00005	SUBR(TVPACK).		PACK TVBUF WITH PICTURE FROM SKY ARRAY.
00800	C00013 00006	SUBR(TVDSKO)  		INPUT TV PICTURE FROM A DISK FILE.
00900	C00015 00007	SUBR(TVXGP)		 VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
01000	C00018 00008	GRAB THE DEVICE.
01100	C00021 00009	SUBR(VICXGP)Q1,Q2	 VIDEO INTENSITY CONTOURS TO XGP.
01200	C00023 00010	
01300	C00024 00011	
01400	C00027 00012	SUBR(CREOUT)		OUTPUT CONTOURS, REGION, EDGE FILE.
01500	C00029 00013	SUBR(CREIN)	 CONTOUR,REGION,EDGE FILE FORMAT INPUT.
01600	C00031 00014	TVIN4.		FOUR BIT TELEVISION INPUT.
01700	C00033 00015	SUBR(TVIN6).		 SIX BIT TELEVISION INPUT.
01800	C00038 ENDMK
01900	C⊗;
     

00100	TITLE CREIO - CRE INPUT OUTPUT SUBROUTINES - BGB - 16 APRIL 1973.
00200	
00300		EXTERN REMAIN,NODCNT,FTVHIS,FTVSIX
00400		EXTERN VCUT,TVBUF,HISTO,AVAIL2,CRE44,FILM,FLGBGB
00500		EXTERN HEADER,HISTOG,CHR
00600		EXTERN DPYBUF,QBLK,DPYIMG
00700		EXTERN RELLOC,SHRINQ,SKY
00800		EXTERN FILNAM,EXTION,PPPN,GETFIL
     

00100	SUBR(FILNUM)SERIAL.	;SETUP FILE-SERIAL-NUMBER-NAME.
00200	BEGIN FILNUM;------------------------------------------------------
00300		EXTERN FNAME6
00400		LAC 10,FNAME6↔LAC 1,[POINT 6,10,-1]	;FILM NAME SIXBIT.
00500		LAC 0,1↔ILDB 2,1↔SKIPE 2↔GO .-3		;SCAN FOR 00.
00600	
00700	;CONVERT SERIAL NUMBER TO SIXBIT DECIMAL NUMERAL.
00800		LACM 1,ARG1↔DAC 1,2↔DAC 1,3↔DAC 1,4↔DAC 1,5
00900		CAIL 1,=10000↔GO L5
01000		CAIL 1,=1000↔GO L4
01100		CAIL 1,=100↔GO L3
01200		CAIL 1,=10↔GO L2
01300			 ↔GO L1
01400	
01500	L5:	IDIVI 1,=10000↔ADDI 1,20↔IDPB 1,0
01600	L4:	IDIVI 2,=1000 ↔ADDI 2,20↔IDPB 2,0
01700	L3:	IDIVI 3,=100  ↔ADDI 3,20↔IDPB 3,0
01800	L2:	IDIVI 4,=10   ↔ADDI 4,20↔IDPB 4,0
01900	L1:	               ADDI 5,20↔IDPB 5,0
02000		DAC 10,FILNAM
02100	
02200	;TMP EXTENSION AND PPPN.
02300		LAC[SIXBIT/TMP/]↔DAC EXTION
02400		DZM EXTION+1
02500		DZM↔SKIPE FLGBGB↔LAC[SIXBIT/DATBGB/]↔DAC PPPN
02600		POP1J
02700	
02800	BEND FILNUM; BGB 19 APRIL 1973 ------------------------------------
     

00100	SUBR(TVDSKI)SERIAL		INPUT TV PICTURE FROM DISK FILE.
00200	
00300	COMMENT/ Serial -1 asks user for file name. Serial ≥0 attempts
00400	film image XXXX00.TMP input. TVDSKI returns TRUE -1 if image
00500	found or FALSE 0 if image not found./
00600	
00700	BEGIN TVDSKI;-----------------------------------------------------
00800	
00900		SKIPL 1,ARG1↔GO[CALL(FILNUM,1)↔GO L1]
01000	L0:	CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])
01100	FALSE:	GO[DZM 1↔POP1J]		;RETURN FALSE - NO PICTURE.
01200	L1:	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
01300		LOOKUP 1,FILNAM↔GO[SKIPGE ARG1↔GO L0↔GO FALSE]
01400	
01500		MOVS PPPN↔MOVMS			;GET FILE SIZE.
01600		CAIN 24400↔GO L2
01700		SUBI 200↔DACN
01800		DIP DUMP2+1
01900		IN 1,DUMP2↔JFCL			;NON-STANDARD SIZE.
02000		CALL(TVPACK)
02100		GO L4
02200	
02300	L2:	IN 1,DUMP1↔JFCL			;216 x 288 STANDARD SIZE.
02400	L4:	OUTSTR[ASCIZ"	EOF.
02500	"]↔	RELEASE 1,↔SETO 1,↔POP1J	;RETURN TRUE.
02600	
02700	DUMP1:	IOWD 200,HEADER
02800		IOWD 24200,TVBUF↔0
02900	DUMP2:	IOWD 200,HEADER
03000		IOWD 24200,SKY↔0
03100	
03200	BEND TVDSKI; BGB 6 DECEMBER 1972 ---------------------------------
     

00100	SUBR(TVPACK).		PACK TVBUF WITH PICTURE FROM SKY ARRAY.
00200	COMMENT/ Take a non-standard size picture from the SKY array and pack
00300	it into the TVBUF. TVPACK loops are for R ← 0 to 215 and for C ← 0 to
00400	287; at each target pixel a check is made to see if there is a source
00500	pixel to be moved./
00600	BEGIN TVPACK;-----------------------------------------------------
00700	
00800		ACCUMULATORS{B,R1,C1,R2,C2,Q0,Q1,Q2}
00900	
01000	;READ TV FILE HEADER & MAKE SURE THAT IT IS REASONIBLE.
01100		SETO↔CAME HEADER↔GO[OUTSTR[ASCIZ/	UNKNOWN, TV FILE FORMAT.
01200	/]↔POP0J]
01300		LAC HEADER+1↔DAC BYTSIZ#
01400		LAC HEADER+2↔DAC WWIDTH#
01500		LAC HEADER+4↔SUB HEADER+3↔AOS↔DAC MROWS#↔LSH -1↔DAC HALFM#
01600		LAC HEADER+6↔SUB HEADER+5↔AOS↔DAC NCOLS#↔LSH -1↔DAC HALFN#
01700	
01800		LAC R2,HALFM↔SUBI R2,=108
01900		LAC Q0,R2↔IMUL Q0,WWIDTH
02000		ADDI Q0,SKY↔CDR 0,HEADER+7↔SUBI 0,200↔ADD Q0,0
02100		LAC Q2,[POINT 6,TVBUF,-1]
02200		DZM R1
02300	L0:	DZM C1↔LAC C2,HALFN↔SUBI C2,=144
02400	L1:	DZM B
02500		SKIPL R2↔CAML R2,MROWS↔GO L2
02600		SKIPL C2↔CAML C2,NCOLS↔GO L2
02700		TLNN Q0,-1↔CALL(L3)
02800		ILDB B,Q1
02900		LSH B,0
03000	L2:	IDPB B,Q2
03100		AOS C2↔AOS C1↔CAIE C1,=288↔GO L1
03200		ADD Q0,WWIDTH↔LAC Q1,Q0
03300		AOS R2↔AOS R1↔CAIE R1,=216↔GO L0
03400		POP0J
03500	
03600	;COMPUTE SOURCE COLUMN BYTE POINTER, ONCE PER PICTURE.
03700	L3:	LAC 0,C2↔IDIV 0,BYTSIZ↔ADD Q0,0		;WORD.
03800		IMUL 1,BYTSIZ↔LACI 0,=36↔SUB 0,1	;P-BITS.
03900		LSH 0,6↔IOR 0,BYTSIZ↔ROT 0,-=12		;S-BITS.
04000		IOR Q0,0↔LAC Q1,Q0
04100		LACI 6↔SUB BYTSIZ↔DAP L2-1
04200		POP0J
04300	
04400	BEND TVPACK; BGB 18 APRIL 1973 -----------------------------------
     

00100	SUBR(TVDSKO)  		INPUT TV PICTURE FROM A DISK FILE.
00200	BEGIN TVDSKO;-----------------------------------------------------
00300	
00400		CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])↔POP0J
00500		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00600		ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/	ENTER FAILED.
00700	/]↔GO .+4]
00800		LAC[XWD HEADER,HEADER+1]↔DZM HEADER↔BLT HEADER+177
00900		LAC[XWD HEAD1,HEADER]↔BLT HEADER+7
01000		OUT 1,DUMARG↔JFCL
01100		OUTSTR[ASCIZ"	EOF.
01200	"]↔	RELEASE 1,↔POP0J
01300	HEAD1:	-1
01400		6	; BITS PER BYTE.
01500		=48	;WORDS PER LINE.
01600		=20	;FIRST AND LAST ROW.
01700		=235
01800		=28
01900		=315	;FIRST AND LAST COL.
02000		XWD -=10368,200
02100	DUMARG:	IOWD 24400,HEADER↔0
02200	BEND TVDSKO; BGB 6 DECEMBER 1973 ---------------------------------
     

00100	SUBR(TVXGP)		 VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
00200	BEGIN TVXGP;------------------------------------------------------
00300		ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
00400	COMMENT/ One to sixteen expansion: (216*4=864) by (288*4=1152).
00500	or 32 words per line. Buffer size (864 lines)*33+1= 28513 words./
00600	
00700	;EXPAND CORE FOR XGP BUFFER & CLEAR THE BUFFER.
00800		LAC 44↔DAC SAV44#↔AOS↔DAC XBUF#↔ADDI =28513+10↔CORE↔GO L5
00900		CDR 1,XBUF↔DZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)
01000	
01100	;PUT CONTROL WORDS IN THE 864 ROWS OF THE XGP IMAGE.
01200		LAC 1,XBUF
01300		SLACI %↔DAC(1)↔AOS 1		     ;CUT PAPER.
01400		SLACI =200⊗6↔DAC(1)↔AOS 1	     ;SPACE DOWN 100 LINES.
01500		LAC[1B11+=192B23+=32]↔LACI 2,=864    ;864 ROWS OF 32 WORDS.
01600		DAC(1)↔ADDI 1,=33↔SOJG 2,.-2	  
01700		LAC[5770B11]↔DAC(1)↔AOS 1	     ;SPACE AFTER PICTURE.
01800		SLACI %↔DAC(1)			     ;CUT PAPER.
01900	
02000	;PACK VIDEO BYTES INTO XGP 4 BY 4 BIT ARRAYS.
02100		LAC P1,[POINT 6,TVBUF,-1]
02200		LAC P2,XBUF↔ADDI P2,3		;BUFFER POINTER.
02300		LACI I,=216
02400	L1:	LACI J,=32
02500	L2:	SETZB 0,1↔SETZB 2,3↔LACI K,=9
02600	L3:	ILDB Q,P1↔TRZ Q,3↔ROTC 0,4↔ROTC 2,4
02700		IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
02800		IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
02900		SOJG K,L3
03000		DAC 0,=00(P2)↔DAC 1,=33(P2)
03100		DAC 2,=66(P2)↔DAC 3,=99(P2)
03200		AOS P2↔SOJG J,L2
03300		ADDI P2,=100↔SOJG I,L1
03400	
     

00100	;GRAB THE DEVICE.
00200	L4:	INIT 1,117
00300		SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
00400	/]↔	POP0J]
00500		SETZ↔SEGNUM
00600		DAC SAVSEG#↔DETSEG
00700		LOCK
00800	
00900	;SLACI -=28516
01000		LAP XBUF↔SOS↔	LIPI -=7130↔	DAC B1
01100		ADDI =7130↔	LIPI -=7128↔	DAC B2
01200		ADDI =7128↔	LIPI -=7128↔	DAC B3
01300		ADDI =7128↔	LIPI -=7130↔	DAC B4
01400	LL5:
01500	;DAC DUMARG
01600		OUT 1,B1↔OUTSTR[ASCIZ/	FIRE BUFFER 1 !/]↔CRLF
01700		OUT 1,B2↔OUTSTR[ASCIZ/	FIRE BUFFER 2 !/]↔CRLF
01800		OUT 1,B3↔OUTSTR[ASCIZ/	FIRE BUFFER 3 !/]↔CRLF
01900		OUT 1,B4↔OUTSTR[ASCIZ/	FIRE BUFFER 4 !/]↔CRLF
02000		UNLOCK
02100		RELEASE 1,
02200	
02300	
02400		LAC SAV44↔CORE
02500	L5:	OUTSTR[ASCIZ/ XGP CORE UUO FAILED.
02600	/]↔	CRLF↔LAC SAVSEG↔ATTSEG↔JFCL↔POP0J
02700	
02800	
02900	;HALF TONE TABLE.
03000	HTT:	6↔7↔7↔6↔	6↔6↔7↔6↔	6↔6↔6↔6↔	6↔6↔6↔6
03100		6↔6↔6↔4↔	4↔6↔6↔4↔	4↔6↔6↔4↔	4↔4↔6↔4
03200		4↔4↔4↔4↔	4↔4↔4↔4↔	0↔4↔4↔4↔	4↔4↔4↔0
03300		0↔4↔4↔0↔	0↔0↔4↔0↔	0↔0↔4↔0↔	0↔0↔0↔0
03400	DUMARG:0↔0
03500	B1:0↔0
03600	B2:0↔0
03700	B3:0↔0
03800	B4:0↔0
03900	BEND;1/19/73-------------------------------------------------------
     

00100	SUBR(VICXGP)Q1,Q2	 VIDEO INTENSITY CONTOURS TO XGP.
00200	BEGIN VICXGP;-----------------------------------------------------
00300		ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
00400		EXTERN VSEG,HSEG,TVBUF,THRESH,PACXOR
00500	;BIT POSITIONS OF THE ARGUMENTS Q1 & Q2 ENABLE INTENSITY CUTS.
00600		LAC 1,ARG2↔DAC 1,Q0#
00700		LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1#
00800		DZM CUT#
00900	;CLEAR THE TMP AREA FOR VSEG-HSEG ACCUMULATION.
01000		LAC[XWD SKY,SKY+1]↔DZM SKY↔BLT SKY+=3500
01100	
01200	;FIND AN INTENSITY CONTOUR ENABLE BIT.
01300	LL0:	LAC 0,Q0↔LAC 1,Q1
01400	LL1:	AOS 2,CUT↔LSHC 0,1↔JUMPL 0,LL2
01500		CAMN 0,1↔JUMPE 0,LL5↔GO LL1
01600	
01700	;THRESHOLD THE TVBUF
01800	LL2:	DAC 0,Q0↔DAC 1,Q1
01900		CALL(THRESH,CUT)
02000		CALL(PACXOR)
02100		LACI 1,=3457↔LAC VSEG(1)↔IORM SKY(1)↔SOJG 1,.-2
02200		GO LL0
02300	
02400	LL5:	LAC[XWD SKY,VSEG]↔BLT VSEG+=3456
     

00100	
00200	;PACK VSEG'S AND HSEG'S INTO THE TVBUF.
00300		LAC[XWD LL3,2]↔BLT 14↔GO 3
00400	LL3:	=62208		;2
00500		ILDB 0,11	;3
00600		ILDB 1,12	;4	;GET HSEG BIT.
00700		 DPB 1,14	;5	;COMBINE THEM.
00800		IDPB 0,13	;6	;PACK THEM INTO TVBUF.
00900		SOJG 2,3	;7
01000		GO LL4		;10
01100		POINT 1,VSEG	;11
01200		POINT 1,HSEG	;12
01300		POINT 6,TVBUF	;13
01400		POINT 1,0,34	;14
01500	LL4:
     

00100	
00200	;EXPAND CORE FOR XGP BUFFER & CLEAR THE BUFFER.
00300		LAC 44↔DAC SAV44#↔AOS↔DAC XBUF#↔ADDI =28513+10↔CORE↔GO L5
00400		CDR 1,XBUF↔DZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)
00500	
00600	;PUT CONTROL WORDS IN THE 864 ROWS OF THE XGP IMAGE.
00700		LAC 1,XBUF
00800		SLACI %↔DAC(1)↔AOS 1		     ;CUT PAPER.
00900		SLACI =200⊗6↔DAC(1)↔AOS 1	     ;SPACE DOWN 100 LINES.
01000		LAC[1B11+=192B23+=32]↔LACI 2,=864    ;864 ROWS OF 32 WORDS.
01100		DAC(1)↔ADDI 1,=33↔SOJG 2,.-2	  
01200		LAC[5770B11]↔DAC(1)↔AOS 1	     ;SPACE AFTER PICTURE.
01300		SLACI %↔DAC(1)			     ;CUT PAPER.
01400	
01500	;PACK VIDEO BYTES INTO XGP 4 BY 4 BIT ARRAYS.
01600		LAC P1,[POINT 6,TVBUF,-1]
01700		LAC P2,XBUF↔ADDI P2,3		;BUFFER POINTER.
01800		LACI I,=216
01900	L1:	LACI J,=32
02000	L2:	SETZB 0,1↔SETZB 2,3↔LACI K,=9
02100	L3:	ILDB Q,P1↔LSH Q,2
02200		CAIN J,=32↔GO[CAIN K,9↔IORI Q,4↔GO .+1]
02300		CAMN J,K↔GO[CAIN J,1↔LACI Q,4↔GO .+1]
02400		CAIE I,=216↔CAIN I,1↔IORI Q,8
02500		ROTC 0,4↔ROTC 2,4
02600		IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
02700		IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
02800		SOJG K,L3
02900		DAC 0,=00(P2)↔DAC 1,=33(P2)
03000		DAC 2,=66(P2)↔DAC 3,=99(P2)
03100		AOS P2↔SOJG J,L2
03200		ADDI P2,=100↔SOJG I,L1
03300	
03400	;GRAB THE DEVICE.
03500	L4:	INIT 1,17↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
03600	/]↔	POP2J]↔SETZ↔SEGNUM↔DAC SAVSEG#↔DETSEG
03700		SLACI -=28516↔LAP XBUF↔SOS↔DAC DUMARG
03800		OUT 1,DUMARG↔RELEASE 1,↔LAC SAV44↔CORE
03900	L5:	OUTSTR[ASCIZ/ XGP CORE UUO FAILED.
04000	/]↔	CRLF↔LAC SAVSEG↔ATTSEG↔JFCL↔POP2J
04100	;HALF TONE TABLE.
04200	HTT:	0↔0↔0↔0↔	8↔8↔8↔8↔	17↔0↔0↔0↔	17↔8↔8↔8
04300	DUMARG:0↔0
04400	BEND VICXGP; BGB 6 MAY 1973 ---------------------------------------
     

00100	SUBR(CREOUT)		OUTPUT CONTOURS, REGION, EDGE FILE.
00200	BEGIN CREOUT;-----------------------------------------------------
00300		CALL(SHRINQ)
00400		CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
00500		LACN FILM
00600		CALL(RELLOC,0)
00700	
00800	;SETUP DUMP OUT ARGUMENT  IOWD.
00900		LAC FILM↔SUB@AVAIL2
01000		LACM 1,0↔MOVSS
01100		LAP CRE44↔DAC OUTARG
01200		LAC@FILM↔DAC TMP#↔DAC 1,@FILM	;FILE SIZE IN WORDS.
01300	
01400	;FILE OUTPUT RITUAL.
01500		LAC@AVAIL2↔SUB FILM↔DAC@AVAIL2
01600		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
01700		ENTER 1,FILNAM
01800		GO[OUTSTR[ASCIZ/	ENTER FAILED.
01900	/]↔GO .+4]
02000		OUT 1,OUTARG↔JFCL
02100		OUTSTR[ASCIZ"	EOF.
02200	"]↔	RELEASE 1,
02300		DZM FILNAM↔SETZ EXTION↔DZM EXTION+1↔DZM PPPN
02400		CALL(RELLOC,FILM)
02500		LAC TMP↔DAC@FILM
02600		LAC@AVAIL2↔ADD FILM↔DAC@AVAIL2
02700		POP0J
02800	OUTARG:	0↔0
02900	BEND CREOUT; BGB 6 DECEMBER 1972 ---------------------------------
     

00100	SUBR(CREIN)	 CONTOUR,REGION,EDGE FILE FORMAT INPUT.
00200	BEGIN CREIN;------------------------------------------------------
00300	
00400		CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
00500		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00600		LOOKUP 1,FILNAM↔GO[RELEASE 1,↔GO CREIN]
00700	
00800		DZM QBLK
00900		LAC PPPN↔LAP FILM↔SOS↔DAC INARG		;IOWD
01000	
01100		MOVS PPPN↔MOVMS↔ADD FILM
01200		IORI 1777↔CAMG 44↔GO L1
01300		CALLI 11↔HALT
01400		LAC 44↔AOS↔SUB FILM
01500		DIVI 7↔DAC 1,REMAINDER
01600	L1:	IN 1,INARG
01700		OUTSTR[ASCIZ"	EOF.
01800	"]↔	RELEASE 1,
01900	
02000		CDR@AVAIL2↔ADD FILM↔DAC@AVAIL2↔DZM@
02100		DIP↔AOS↔LAC 1,44↔BLT(1)		       ;CLEAR EMPTY AREA.
02200		CALL(RELLOC,FILM)
02300	
02400	;RESET AVAIL2 LIST.
02500		LAC 1,@AVAIL2↔LAC 2,44
02600		LIPI 1,NODSIZ(1)↔GO L6
02700	L5:	HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
02800	L6:	CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
02900		SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
03000		POP0J
03100	INARG:	0↔0
03200	BEND CREIN; BGB 28 JANUARY 1973 ----------------------------------
     

00100	;TVIN4.		FOUR BIT TELEVISION INPUT.
00200	SUBR(TVIN4)------------------------------------------------------
00300	BEGIN TVIN4
00400		LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
00500		ADDI=6912↔CORE↔POP0J
00600	L0:	INIT 17,17↔SIXBIT/TV/↔0
00700		GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
00800		DZM TVERR↔INPUT 17,TVPTR↔RELEASE 17,
00900	
01000	;REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
01100		LAC 1,TVERR
01200		TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
01300	/]↔	TRNE 1,000040↔OUTSTR[ASCIZ/TV DATA MISS.
01400	/]↔	TRNE 1,000020↔OUTSTR[ASCIZ/TV NON EX MEM.
01500	/]↔	TRNE 1,100060↔JRST L0
01600		TIMER↔DAC TVTIME#
01700		DATE↔DAC TVDATE#
01800		OUTSTR[ASCIZ/AKEN./]
01900		LAC[XWD HISTO,HISTO+1]		;CLEAR THE HISTOGRAM.
02000		DZM HISTO↔BLT HISTO+77
02100	
02200	;CONVERT FROM GREY CODE TO GRAY CODE.
02300		LAC 16,[XWD L,0]↔BLT 16,12
02400		LAP TVPTR↔GO 4
02500	
02600	L:	POINT 4,0,-1↔		FROM←←0
02700		POINT 6,TVBUF,-1↔	TO←←1
02800		=62208	↔		CNT←←2
02900		0	↔		BYT←←3
03000		ILDB BYT,FROM		;4
03100		LAC BYT,GRAY(BYT)	;3
03200		LSH BYT,2		;6
03300		AOS HISTO(BYT)		;7
03400		IDPB BYT,TO		;8
03500		SOJG CNT,4		;9
03600		GO .+1			;12
03700		LAC TMP44↔CORE↔HALT↔POP0J
03800	
03900	BEND TVIN4; BGB 14 DECEMBER 1972 ---------------------------------
04000	
04100	TVPTR:	XWD -=6912,0	↔ INTERN TVPTR
04200	TVCLIP:	701002		;BCLIP=7 TCLIP=0 CAM=1.
04300	INTERN TVCLIP
04400	TVYXW:	BYTE(9)50,34,40
04500	TVERR:	0
04600	GRAY:	OCT 12,13,11,10,15,14,16,17,5,4,6,7,2,3,1,0
     

00100	SUBR(TVIN6).		 SIX BIT TELEVISION INPUT.
00200	BEGIN TVIN6;-----------------------------------------------------
00300		LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
00400		ADDI=6912*4↔CORE↔POP0J
00500	L0:	INIT 17,17↔SIXBIT/TV/↔0
00600		GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
00700		DZM TVERR6#↔PUSH P,TVCLIP
00800	
00900		LACI 76↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 76.
01000		LAC TVPTR↔LIPI 440400↔DAC P1#
01100	L1:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
01200		IORM TVERR6↔TRNE 100060↔GO L1
01300	
01400		LACI 54↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 54.
01500		LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P2#
01600	L2:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
01700		IORM TVERR6↔TRNE 100060↔GO L2
01800	
01900		LACI 32↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 32.
02000		LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P3#
02100	L3:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
02200		IORM TVERR6↔TRNE 100060↔GO L3
02300	
02400		LACI 10↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 10.
02500		LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P4#
02600	L4:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
02700		IORM TVERR6↔TRNE 100060↔GO L4
02800		POP P,TVCLIP↔RELEASE 17,
02900	
03000	;REPORT ON THE ERROR BITS.
03100		LAC 1,TVERR6
03200		TRNE	1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
03300	/]↔	TRNE	1,40	↔OUTSTR[ASCIZ/TV DATA MISS.
03400	/]↔	TRNE	1,20	↔OUTSTR[ASCIZ/TV NON EX MEM.
03500	/]↔	TIMER↔DAC TVTIME#
03600		DATE↔DAC TVDATE#
03700		LAC[XWD HISTO,HISTO+1]↔DZM HISTO↔BLT HISTO+77
03800		OUTSTR[ASCIZ/AKEN./]
03900	;CONVERT FROM GREY CODE TO GRAY CODE.
04000		LAC[POINT 6,TVBUF,-1]↔DAC P5#
04100		LAC[XWD L,3]↔BLT 16↔LACI =62208↔GO 3
04200	
04300	;SIX BIT AC-LOOP.
04400	L:	ILDB 1,P1↔LAC 2,GRAY(1)
04500		ILDB 1,P2↔ADD 2,GRAY(1)
04600		ILDB 1,P3↔ADD 2,GRAY(1)
04700		ILDB 1,P4↔ADD 2,GRAY(1)
04800		IDPB 2,P5↔AOS  HISTO(2)
04900		SOJG 0,3↔GO .+1
05000		LAC TMP44↔CORE↔HALT↔POP0J
05100	BEND TVIN6; BGB 14 DECEMBER 1972 ---------------------------------
05200	END